home *** CD-ROM | disk | FTP | other *** search
/ CD ROM Paradise Collection 4 / CD ROM Paradise Collection 4 1995 Nov.iso / program / swagd_f.zip / EGAVGA.SWG / 0156_VGA Fonts for DPMI and REAL.pas < prev    next >
Pascal/Delphi Source File  |  1995-03-03  |  10KB  |  213 lines
  1. {
  2.     With all the tonnes of absolutely NO help that the Pascal conferences
  3.     provided me <in one day> I've managed to hack my VGA Font loading code
  4.     to work properly in p-mode.
  5.  
  6.     It's quite a trick getting the DPMI servers to allocate memory under
  7.     the one meg mark, but it is possible if you write a couple of routines
  8.     like the ones below (or golly-gee, use those! :) ..
  9.  
  10.     Oh yeah - one other tip.  Those of you who use OpCrt, TpCrt, or maybe
  11.     even plain CRT.  The ScreenHeight function will not return the correct
  12.     value after a font change (if the change is a new line mode) unless you
  13.     call ReInitCRT.
  14.  
  15.     Here's the code:
  16. }
  17. Unit LF;
  18.  
  19. {$IFDEF Windows}
  20.   This will not work with Windows!
  21. {$ENDIF}
  22.  
  23. { Text-mode font routines                                                    }
  24. { (c)1994 Chris Lautenbach                                                   }
  25. {                                                                            }
  26. { Date         Revision     Description                                      }
  27. { ────────────────────────────────────────────────────────────────────────── }
  28. { Sep 07 94         1.0     Wrote real mode routines                         }
  29. { Sep 09 94         1.1     Added protected mode versions                    }
  30.  
  31. { Notes:                                                                     }
  32.  
  33. { It is important to note, that under protected mode, the normal VGA BIOS    }
  34. { extensions could not access the memory procured by GetMem().  This is why  }
  35. { the SimulateRealModeInt() and XGlobalDosAlloc() routines were needed.      }
  36. { XGlobalDosAlloc() allocates memory under the 1mb mark that the VGA BIOS is }
  37. { capable of accessing, and thereby allows font loads in p-mode.             }
  38.  
  39. { Any size/line font may be used.  This is because I used subfunction $11    }
  40. { instead of $10.  $11 will calculate the scanlines/etc required for the     }
  41. { font you are loading by dividing the number of characters by the fonts     }
  42. { total size (as does LoadFont(), so that we may properly allocate memory).  }
  43. { I've tested 25, 33, 50, and 66 line mode fonts with it and they all work   }
  44. { fine.  Make sure the font you are loading is _pure_ binary, and does not   }
  45. { contain header information for some sort of font editing/loading program.  }
  46.  
  47. { The calls to LoadFont() are identical in p-mode to real mode, so you won't }
  48. { need to do any code changes should you decide to switch between the modes  }
  49. { later on.  Nor is any special setup necessary.  Just USE it, and load      }
  50. { fonts, that's it! :)                                                       }
  51.  
  52. { Restrictions:                                                              }
  53.  
  54. { Don't you dare use this code for profit without proclaiming my name in a   }
  55. { prominent place in your program!  :) (Oh, and it don't work under Windoze  }
  56. { but I'm sure you knew that...)                                             }
  57.  
  58. INTERFACE
  59.  
  60. {$IFDEF DPMI}
  61. Uses WinApi;
  62. {$ENDIF}
  63.  
  64. function LoadFont(FileName : string) : boolean;
  65. { Loads a 255-character font from FileName to font 0 and sets it on }
  66.  
  67. procedure NormalFont;
  68. { Returns the system to the normal system 8x16 character font }
  69. { !! This routine works fine under p-mode without modifications since it }
  70. {    does no memory allocation of any kind. }
  71.  
  72. IMPLEMENTATION
  73.  
  74. {$IFDEF DPMI}
  75. Type LongRec = record
  76.        Selector, Segment : word;
  77.      end;
  78.  
  79.      DoubleWord = record
  80.        Lo, Hi : word;
  81.      end;
  82.  
  83.      QuadrupleByte = record
  84.        Lo, Hi, sLo, sHi : byte;
  85.      end;
  86.  
  87.      TDPMIRegisters = record
  88.        EDI, ESI, EBP, Reserved, EBX, EDX, ECX, EAX : longint;
  89.        Flags, ES, DS, FS, GS, IP, CS, SP, SS : word;
  90.      end;
  91.  
  92.   function XGlobalDosAlloc(Size : longint; var P : Pointer) : word;
  93.   { Allocates memory in an area that DOS can access properly }
  94.   var Long : longint;
  95.   begin
  96.     Long := GlobalDosAlloc(Size);
  97.     P := Ptr(LongRec(Long).Selector, 0);
  98.     XGlobalDosAlloc := LongRec(Long).Segment;
  99.   end;
  100.  
  101. ... Viper: The offline mail reader for the best of us.
  102. ___ Viper v2.0 [0004] * Multi-part message, 1 of 3 *
  103. ---
  104.  ■ RoseMail 2.55ß: NANet - Toronto Twilight (416)663-1103 - 7 Nodes
  105.                                        
  106. {SWAG=???.SWG,CHRIS LAUTENBACH,VGA Fonts, they work[2/3]}
  107.  
  108.   function SimulateRealModeInt(IntNo : word;
  109.                                var Regs : TDPMIRegisters) : word; assembler;
  110.   { Simulates a real mode interrupt }
  111.   asm
  112.     PUSH BP                                          { Save BP, just in case }
  113.     MOV BX,IntNo                         { Move the Interrupt number into BX }
  114.     XOR CX,CX                                                     { Clear CX }
  115.     LES DI,Regs                              { Load the registers into ES:DI }
  116.     MOV AX,$300                                { Set function number to 300h }
  117.     INT $31                             { Call Interrupt 31h - DPMI Services }
  118.     JC @Exit                                         { Jump to exit on carry }
  119.     XOR AX,AX                                                     { Clear AX }
  120.     @Exit:                                                      { Exit label }
  121.     POP BP                                                      { Restore BP }
  122.   end;
  123.  
  124.   function LoadFont(FileName : string) : boolean;
  125.   { Loads a 255-character font from FileName to font 0 and sets it on }
  126.   var FontFile : file;
  127.       Font, Tmp : pointer;
  128.       S, O, FontSize, RMSeg, DPSel : word;
  129.       BPC : byte;
  130.       Regs : TDPMIRegisters;
  131.   begin
  132.     {$I-}
  133.     Assign(FontFile, FileName);                              { Open the file }
  134.     Reset(FontFile, 1);                                           { Reset it }
  135.     {$I+}
  136.     If (IOResult <> 0) then                  { File opening was unsuccessful }
  137.     begin
  138.       LoadFont := FALSE;                                      { Return FALSE }
  139.       Exit;                                               { Return to caller }
  140.     end;
  141.     FontSize := FileSize(FontFile);                      { Get the font size }
  142.     FillChar(Regs, SizeOf(Regs), #0);             { Clear the DPMI registers }
  143.     Regs.ES := XGlobalDosAlloc(FontSize, Font);            { Allocate memory }
  144.     BlockRead(FontFile, Font^, FontSize);                    { Load the font }
  145.     BPC := FontSize DIV 256;                 { Calculate bytes per character }
  146.     Close(FontFile);                                   { Close the font file }
  147.     DoubleWord(Regs.EBP).Hi := Regs.ES;       { Load font address into ES:BP }
  148.     QuadrupleByte(Regs.EAX).Hi := $11;                    { Set function $11 }
  149.     QuadrupleByte(Regs.EAX).Lo := $10;                { Set sub-function $10 }
  150.     QuadrupleByte(Regs.EBX).Hi := BPC;        { Set # of bytes per character }
  151.     QuadrupleByte(Regs.EBX).Lo := $00;                { Set font number to 0 }
  152.     DoubleWord(Regs.ECX).Lo := $FF;               { # of chars to load = 256 }
  153.     DoubleWord(Regs.EDX).Lo := $0;                     { Set start char to 0 }
  154.     SimulateRealModeInt($10, Regs);                     { Call the interrupt }
  155.     GlobalDosFree(LongRec(Font).Selector);              { Free up the memory }
  156.     LoadFont := TRUE;                   { Return TRUE - function successful! }
  157.   end;
  158. {$ENDIF}
  159.  
  160. {$IFDEF MSDOS}
  161.   function LoadFont(FileName : string) : boolean;
  162.   { Loads a 255-character font from FileName to font 0 and sets it on }
  163.   var FontFile : file;
  164.       Font, Tmp : pointer;
  165.       S, O, FontSize, RMSeg, DPSel : word;
  166.       BPC : byte;
  167.   begin
  168.     {$I-}
  169.     Assign(FontFile, FileName);                              { Open the file }
  170.     Reset(FontFile, 1);                                           { Reset it }
  171.     {$I+}
  172.     If (IOResult <> 0) then                  { File opening was unsuccessful }
  173.     begin
  174.       LoadFont := FALSE;                                      { Return FALSE }
  175.       Exit;                                               { Return to caller }
  176.     end;
  177.     FontSize := FileSize(FontFile);                      { Get the font size }
  178.     GetMem(Font, FontSize);                       { Allocate memory for font }
  179.     BlockRead(FontFile, Font^, FontSize);                    { Load the font }
  180.     BPC := FontSize DIV 256;                 { Calculate bytes per character }
  181.     Close(FontFile);                                   { Close the font file }
  182.     S := Seg(Font^);                                   { Get segment of font }
  183.     O := Ofs(Font^);                                    { Get offset of font }
  184.     asm
  185.       PUSH BP                                                      { Save BP }
  186.       MOV AL,$10                                      { Set sub-function $10 }
  187.       MOV AH,$11                                          { Set function $11 }
  188.       MOV BH,BPC                              { Set # of bytes per character }
  189.       MOV BL,$00                                        { Set font # to load }
  190.       MOV CX,$FF                                    { Set # of chars to load }
  191.       MOV DX,$0                           { Set start of load to character 0 }
  192.       MOV ES,S                                { Load segment of font to load }
  193.       MOV BP,O                                 { Load offset of font to load }
  194.       INT $10                                      { Call BIOS Interrupt 10h }
  195.       POP BP                                                    { Restore BP }
  196.     end;
  197.     FreeMem(Font, FontSize);                      { Release allocated memory }
  198.     LoadFont := TRUE;                   { Return TRUE - function successful! }
  199.   end;
  200. {$ENDIF}
  201.  
  202.   procedure NormalFont; assembler;
  203.   { Returns the system to the normal system 8x16 character font }
  204.   asm
  205.     MOV AL,$04                                        { Set sub-function 04h }
  206.     MOV AH,$11                                            { Set function 11h }
  207.     MOV BL,$00                           { Select font 0 as the one to reset }
  208.     INT $10                                        { Call BIOS Interrupt 10h }
  209.   end;
  210.  
  211. begin
  212. end.
  213.